home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 26 / AACD 26.iso / AACD / Programming / AllPlaton / Unsorted / VFX.AMOS / VFX.amosSourceCode
Encoding:
AMOS Source Code  |  1995-11-01  |  39.5 KB  |  1,623 lines
  1. ' *************************************
  2. ' *                                   *
  3. ' *              VFX V0.0             *
  4. ' *      Written by Chris Hodges      *
  5. ' *                                   *
  6. ' *************************************
  7. '
  8. Set Buffer 40
  9. If Screen<>-1 Then Screen Close 0
  10. 'MXFILES=200 
  11. Dim FIL$(MXFILES)
  12. Dim FB(60,4),FB$(60)
  13. Global FB(),FB$()
  14. TH=8
  15. Global TH
  16. Dim AC$(2),DI$(3),DIT(3,7)
  17. FANI$="dh1:Blab/Test"
  18. Gosub INIT
  19. Gosub MAIN
  20. End 
  21. MAIN:
  22.   Do 
  23.     OMK=MK
  24.     Screen 0
  25.     XM=X Screen(X Mouse) : YM=Y Screen(Y Mouse) : MK=Mouse Key : I$=Inkey$
  26.     If I$="" Then Multi Wait 
  27.     BT=0
  28.     If YM=0 : I$=Cup$ : End If 
  29.     If YM>84
  30.       If XM=0 : I$=Cleft$ : End If 
  31.       If XM=638 : I$=Cright$ : End If 
  32.       If YM=260 : I$=Cdown$ : End If 
  33.     Else 
  34.       If MK=1 and OMK<>1
  35.         CHKMOUSE[XM,YM,25,59]
  36.         BT=Param
  37.       End If 
  38.     End If 
  39.     Exit If BT=25
  40.     If BT=26 Then Amos To Back 
  41.     If BT=27 Then Gosub LOAIFF
  42.     If BT=28 Then Gosub LOABACKGROUND
  43.     If BT=29 Then Gosub VIEBACKGROUND
  44.     If BT=30 Then Gosub BACKTOMAIN
  45.     If BT=31 Then Gosub DELBACK
  46.     If BT=37 Then Gosub ENTNUMFRAMES
  47.     If BT=38 Then Add DI,1,0 To 3 : NEWTEX[BT,DI$(DI)]
  48.     If BT=39 Then Add ACCL,1,0 To 2 : NEWTEX[BT,AC$(ACCL)]
  49.     If BT=32 Then Gosub SELECTEFX
  50.     If BT=33 Then Gosub SETEFXPARAMS
  51.     If BT=34 Then Gosub PREVIEWANIM
  52.     If BT=35 Then Gosub MAKEANIM
  53.     If BT=36 Then Gosub ANIPLAYBACK
  54.   Loop 
  55. Return 
  56. INIT:
  57.   Degree 
  58.   Screen Open 0,640,84,4,$8000
  59.   Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 0
  60.   Palette 0,$FFF,$AAA,$666
  61.   Colour 17,$BDF : Colour 18,$6F : Colour 19,$12
  62.   Screen Display 0,128,40,320,84
  63.   Wait Vbl 
  64.   Limit Mouse 
  65.   FRMN=50 : DI=0 : ACCL=0
  66.   EFX=1
  67.   PIEX=10 : PIEY=10 : ZUF=0 : RAD=200
  68.   BASE=0
  69.   AC$(0)="@ Accelerate: no"
  70.   AC$(1)="@ Accelerate: >�"
  71.   AC$(2)="@ Accelerate: ï¿½<"
  72.   DI$(0)="@ Direction : ->"
  73.   DI$(1)="@ Direction : <-"
  74.   DI$(2)="@ Direction : <>"
  75.   DI$(3)="@ Direction : ><"
  76.   Gosub CREATEMAINSCREEN
  77.   Restore DITHER
  78.   For Y=0 To 7
  79.     For X=0 To 3
  80.       Read DIT(X,Y)
  81.     Next 
  82.   Next 
  83. Return 
  84. CREATEMAINSCREEN:
  85.   Screen 0
  86.   Gr Writing 0
  87.   Cls 0
  88.   DEFCLOWIN[25,0,0]
  89.   TEXBOX[19,0,616,10,0,"VFX V0.0 by Chris Hodges."]
  90.   DEFSCRTBK[26,617,0]
  91.   FILBOX[0,11,639,83,0]
  92.   DEFTEX[27,4,13,84,23,"Load Iff",1]
  93.   DEFTEX[28,4,25,84,35,"Load Back",1]
  94.   DEFTEX[29,4,37,84,47,"View Back",1]
  95.   DEFTEX[30,4,49,84,59,"Back->Main",1]
  96.   DEFTEX[31,4,61,84,71,"Kill Back",1]
  97.   DEFTEX[32,87,13,214,23,"Choose Efx",1]
  98.   DEFTEX[33,87,25,214,35,"Change Args",1]
  99.   DEFTEX[34,87,37,214,47,"Preview Anim",1]
  100.   DEFTEX[35,87,49,214,59,"Save Anim",1]
  101.   DEFTEX[36,87,61,214,71,"Playback Anim",1]
  102.   DEFTEX[37,217,13,354,23,"Frames: "+ Extension_8_0EB8(FRMN,4),1]
  103.   DEFTEX[38,217,25,354,35,DI$(DI),1]
  104.   DEFTEX[39,217,37,354,47,AC$(ACCL),1]
  105.   DEFBOX[60,4,73,635,81,0]
  106.   DRAPROCBAR[60,1,1]
  107. Return 
  108. SELECTEFX:
  109.   Do 
  110.     If BASE=0 Then REQUEST["Select effect (1/2):","Explosion|Implosion|ScrollPageL|ScrollPageR|->"]
  111.     If BASE=1 Then REQUEST["Select effect (2/2):","ScrollPageU|ScrollPageD|Pixelize|Undefined|->"]
  112.     If Param=4 Then Add BASE,1,0 To 1 Else EFX=Param+1+BASE*4 : Exit 
  113.   Loop 
  114.   Gosub SETEFXPARAMS
  115. Return 
  116. SETEFXPARAMS:
  117.   On EFX Gosub EXBLOSIONSET,EXBLOSIONSET,SCROLPAGESET,SCROLPAGESET,SCROLPAGESET,SCROLPAGESET,PIXELIZESET
  118. Return 
  119. EXBLOSIONSET:
  120.   NUMENT["Enter number of pieces in X direction:","Ok",PIEX,0,250]
  121.   PIEX=Max(Val(Mid$(Param$,2)),1)
  122.   NUMENT["Enter number of pieces in Y direction:","Ok",PIEY,0,250]
  123.   PIEY=Max(Val(Mid$(Param$,2)),1)
  124.   NUMENT["Enter radius of explosion:","Ok",200,0,400]
  125.   RAD=Val(Mid$(Param$,2))
  126.   NUMENT["Enter randomizer percentage:","Ok",ZUF,0,100]
  127.   ZUF=Val(Mid$(Param$,2))
  128. Return 
  129. SCROLPAGESET:
  130.   NUMENT["Enter delta height/width of page:","Ok",32,0,100]
  131.   RAD=Max(Val(Mid$(Param$,2)),8)
  132. Return 
  133. PIXELIZESET:
  134.   NUMENT["Enter rotation radius:","Ok",4,0,32]
  135.   RAD=Val(Mid$(Param$,2))
  136. Return 
  137. ENTNUMFRAMES:
  138.   NUMENT["Enter number of frames:","Accept|Cancel",FRMN,0,500]
  139.   A$=Param$
  140.   If Left$(A$,1)="0"
  141.     FRMN=Max(Val(Mid$(A$,2)),2)
  142.     NEWTEX[BT,"Frames: "+ Extension_8_0EB8(FRMN,4)]
  143.   End If 
  144. Return 
  145. PREVIEWANIM:
  146.   If MAINPIC=0 Then REQUEST["Load a main picture first!","Ok"] : Return 
  147.   PREVIEW=1
  148.   Gosub CREATEANIM
  149. Return 
  150. MAKEANIM:
  151.   If MAINPIC=0 Then REQUEST["Load a main picture first!","Ok"] : Return 
  152.   PREVIEW=0 : BPIC=0
  153.   FILEREQ[-1,480,160,-1,"Enter base picture name", Extension_8_02F0(FANI$), Extension_8_03E0(FANI$),"","Ok","Abort","","PS"]
  154.   Screen 0 : Limit Mouse 
  155.   If Param$="" Then Return 
  156.   FANI$=Param$
  157.   If Exist(FANI$+"0000")
  158.     REQUEST["Overwrite old animation?","Overwrite|Append|Cancel"]
  159.     If Param=2 : Return : End If 
  160.     If Param=0
  161.       PIC=0
  162.       Do 
  163.         Exit If Exist(FANI$+ Extension_8_0EB8(PIC,4))=0
  164.         Trap Kill FANI$+ Extension_8_0EB8(PIC,4)
  165.         Inc PIC
  166.       Loop 
  167.     End If 
  168.     If Param=1
  169.       BPIC=0
  170.       Do 
  171.         Exit If Exist(FANI$+ Extension_8_0EB8(BPIC,4))=0
  172.         Inc BPIC
  173.       Loop 
  174.     End If 
  175.   End If 
  176.   Gosub CREATEANIM
  177. Return 
  178. CREATEANIM:
  179.   Screen Hide 0 : Screen Hide 1
  180.   Screen Open 2,SCX,SCY,SCC,SCR
  181.   Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 0
  182.   Screen Display 2,128,40,SCX,SCY
  183.   Get Palette 1
  184.   On EFX Gosub EXBLOSIONINIT,EXBLOSIONINIT,NI,NI,NI,NI,NI
  185.   ABORT=0 : PIC=0
  186.   If DI=0
  187.     For FC=0 To FRMN-1
  188.       Gosub CALCFRAME
  189.       Exit If ABORT
  190.     Next 
  191.   End If 
  192.   If DI=1
  193.     For FC=FRMN-1 To 0 Step -1
  194.       Gosub CALCFRAME
  195.       Exit If ABORT
  196.     Next 
  197.   End If 
  198.   If DI=2
  199.     For FCC=0 To FRMN-1
  200.       FC=Abs(FCC*2-(FRMN-1))
  201.       Gosub CALCFRAME
  202.       Exit If ABORT
  203.     Next 
  204.   End If 
  205.   If DI=3
  206.     For FCC=0 To FRMN-1
  207.       FC=(FRMN-1)-Abs(FCC*2-(FRMN-1))
  208.       Gosub CALCFRAME
  209.       Exit If ABORT
  210.     Next 
  211.   End If 
  212.   Erase 9
  213.   Screen Close 2
  214.   Screen Show 0 : Screen Show 1
  215.   Screen 0
  216. Return 
  217. CALCFRAME:
  218.   If Inkey$=Chr$(27) or Mouse Key<>0 Then ABORT=1
  219.   If BACKPIC=0
  220.     Cls 
  221.   Else 
  222.     Screen Copy 3 To 2
  223.   End If 
  224.   If PREVIEW
  225.     Home : Pen Extension_8_1504($FFF) : Paper Extension_8_1504(0)
  226.     Print "Frame "+ Extension_8_0EB8(PIC+1,4)+" of "+ Extension_8_0EB8(FRMN,4)+"."
  227.   End If 
  228.   If ACCL=0
  229.     POS=FC : MPOS=FRMN-1
  230.   End If 
  231.   If ACCL=1
  232.     MPOS=(FRMN-1)*16
  233.     POS=Sqr(MPOS*MPOS-(MPOS-FC*16)*(MPOS-FC*16))
  234.   End If 
  235.   If ACCL=2
  236.     MPOS=(FRMN-1)*16
  237.     POS=MPOS-Sqr(MPOS*MPOS-(FC*FC*256))
  238.   End If 
  239.   RPOS=MPOS-POS
  240.   On EFX Gosub EXBLOSION,EXBLOSION,SCRPAGEL,SCRPAGER,SCRPAGEU,SCRPAGED,PIXELIZE
  241.   If PREVIEW=0
  242.     Save Iff FANI$+ Extension_8_0EB8(PIC+BPIC,4)
  243.   Else 
  244.     Home : Pen Extension_8_1504($FFF)
  245.     Print "Frame "+ Extension_8_0EB8(PIC+1,4)+" of "+ Extension_8_0EB8(FRMN,4)+"."
  246.   End If 
  247.   Inc PIC
  248. Return 
  249. EXBLOSIONINIT:
  250.   Reserve As Work 9,PIEX*PIEY*4
  251.   ST=Start(9)
  252.   For Y=0 To PIEY-1
  253.     For X=0 To PIEX-1
  254.       DX=(SCX/2)-(SCX*X)/PIEX
  255.       DY=(SCY/2)-(SCY*Y)/PIEY
  256.       If EFX=2 Then DX=-DX : DY=-DY
  257.       ARC[DX,DY] : W=Param
  258.       A=(W*(100-ZUF)+(Rnd(1023)-512)*ZUF)/100
  259.       XX=(SCX*X)/PIEX+ Extension_8_1114(A,RAD)
  260.       YY=(SCY*Y)/PIEY+ Extension_8_1106(A,RAD)
  261.       Doke ST,XX : Doke ST+2,YY : Add ST,4
  262.     Next 
  263.   Next 
  264. Return 
  265. NI:
  266. Return 
  267. EXBLOSION:
  268.   ST=Start(9)
  269.   For Y=0 To PIEY-1
  270.     For X=0 To PIEX-1
  271.       X1=(SCX*X)/PIEX : Y1=(SCY*Y)/PIEY
  272.       X2= Extension_8_0BE4(ST) : Y2= Extension_8_0BE4(ST+2) : Add ST,4
  273.       XX=(X1*RPOS+X2*POS)/MPOS
  274.       YY=(Y1*RPOS+Y2*POS)/MPOS
  275.       If((X1*3+Y1*7) and 255)>((POS*256)/MPOS) Then T=1 Else T=0
  276.       SX=((((SCX*(X+1))/PIEX)-X1)*RPOS)/MPOS+T
  277.       SY=((((SCY*(Y+1))/PIEY)-Y1)*RPOS)/MPOS+T
  278.       Screen Copy 1,X1,Y1,X1+SX,Y1+SY To 2,XX,YY
  279.     Next 
  280.   Next 
  281. Return 
  282. SCRPAGEL:
  283.   OX=0
  284.   For X=0 To SCX-1
  285.     XT=((SCX+RAD)*POS)/MPOS-RAD
  286.     If X<=XT
  287.       YY=0 : XX=X
  288.     Else 
  289.       A=X-XT
  290.       XX=X-((A*A)/(RAD*4))
  291.       If XX<OX-1
  292.         XX=OX-1
  293.       End If 
  294.       YY=Max((XT-X)/4,-RAD)
  295.     End If 
  296.     OX=XX
  297.     Screen Copy 1,X,0,X+1,SCY To 2,XX,YY
  298.   Next 
  299. Return 
  300. SCRPAGER:
  301.   OX=0
  302.   For X=0 To SCX-1
  303.     XT=((SCX+RAD)*POS)/MPOS-RAD
  304.     If X<=XT
  305.       YY=0 : XX=X
  306.     Else 
  307.       A=X-XT
  308.       XX=X-((A*A)/(RAD*4))
  309.       If XX<OX-1
  310.         XX=OX-1
  311.       End If 
  312.       YY=Max((XT-X)/4,-RAD)
  313.     End If 
  314.     OX=XX
  315.     Screen Copy 1,SCX-X-1,0,SCX-X,SCY To 2,SCX-XX-1,YY
  316.   Next 
  317. Return 
  318. SCRPAGEU:
  319.   OY=0
  320.   For Y=0 To SCY-1
  321.     YT=((SCY+RAD)*POS)/MPOS-RAD
  322.     If Y<=YT
  323.       XX=0 : YY=Y
  324.     Else 
  325.       A=Y-YT
  326.       YY=Y-((A*A)/(RAD*4))
  327.       If YY<OY-1
  328.         YY=OY-1
  329.       End If 
  330.       XX=Max((YT-Y)/4,-RAD)
  331.     End If 
  332.     OY=YY
  333.     Screen Copy 1,0,Y,SCX,Y+1 To 2,XX,YY
  334.   Next 
  335. Return 
  336. SCRPAGED:
  337.   OY=0
  338.   For Y=0 To SCY-1
  339.     YT=((SCY+RAD)*POS)/MPOS-RAD
  340.     If Y<=YT
  341.       XX=0 : YY=Y
  342.     Else 
  343.       A=Y-YT
  344.       YY=Y-((A*A)/(RAD*4))
  345.       If YY<OY-1
  346.         YY=OY-1
  347.       End If 
  348.       XX=Max((YT-Y)/4,-RAD)
  349.     End If 
  350.     OY=YY
  351.     Screen Copy 1,0,SCY-Y-1,SCX,SCY-Y To 2,XX,SCY-YY-1
  352.   Next 
  353. Return 
  354. PIXELIZE:
  355.   SX=(SCX*RPOS)/MPOS
  356.   SY=(SCY*RPOS)/MPOS
  357.   For Y=0 To SY-1
  358.     For X=0 To SX-1
  359.       DX= Extension_8_1114((POS*4096)/MPOS,RAD)
  360.       DY= Extension_8_1106((POS*4096)/MPOS,RAD)
  361.       If SX>0 and SY>0
  362.         X1=(SCX*X)/SX
  363.         Y1=(SCY*Y)/SY
  364.         X2=(SCX*(X+1))/SX
  365.         Y2=(SCY*(Y+1))/SY
  366.       Else 
  367.         X1=0 : Y1=0
  368.         X2=SCX-1 : Y2=SCY-1
  369.       End If 
  370.       Screen 1
  371.       P= Extension_8_039E(Max(Min(X1+DX,SCX-1),0),Max(Min(Y1+DY,SCY-1),0))
  372.       Screen 2
  373.       If X2-X1<2 and Y2-Y1<2
  374.          Extension_8_0388 X1,Y1,P
  375.       Else 
  376.         If X2-X1<2
  377.            Extension_8_1016 X1,Y1 To X1,Y2,P
  378.         Else 
  379.           If Y2-Y1<2
  380.              Extension_8_1016 X1,Y1 To X2,Y1,P
  381.           Else 
  382.             Ink P : Bar X1,Y1 To X2-1,Y2-1
  383.           End If 
  384.         End If 
  385.       End If 
  386.     Next 
  387.   Next 
  388. Return 
  389. VIEBACKGROUND:
  390.   If BACKPIC=0 Then Return 
  391.   If MAINPIC Then Screen Hide 1
  392.   Screen Show 3 : Screen To Front 3
  393.   Screen Display 3,128,40,SCX,SCY
  394.   Repeat 
  395.     Multi Wait 
  396.   Until Mouse Key<>0 or Inkey$<>""
  397.   Screen Hide 3
  398.   If MAINPIC Then Screen Show 1
  399.   While Mouse Key : Multi Wait : Wend 
  400. Return 
  401. BACKTOMAIN:
  402.   If BACKPIC=0 or MAINPIC=0 Then Return 
  403.   Screen Copy 3 To 1
  404. Return 
  405. DELBACK:
  406.   If BACKPIC=0 Then Return 
  407.   Screen Close 3
  408.   BACKPIC=0
  409. Return 
  410. ANIPLAYBACK:
  411.   FILEREQ[-1,480,160,-1,"Select base picture", Extension_8_02F0(FANI$)+"0000", Extension_8_03E0(FANI$),"#?0000","Play","Abort","","P"]
  412.   Screen 0
  413.   If Param$="" Then Return 
  414.   FANI$=Param$-"0000"
  415.   If Exist(FANI$+"0000")=0
  416.     REQUEST["Can't find first picture!","Argl"]
  417.     Return 
  418.   End If 
  419.   PIC=0
  420.   Screen Hide 0 : If MAINPIC Then Screen Hide 1
  421.   Load Iff FANI$+"0000",2
  422.   Double Buffer : Autoback 0
  423.   Do 
  424.     Exit If Mouse Key<>0 or Inkey$<>""
  425.     If Exist(FANI$+ Extension_8_0EB8(PIC,4))=0 Then PIC=0
  426.     Load Iff FANI$+ Extension_8_0EB8(PIC,4)
  427.     Multi Wait : Screen Swap 
  428.     Inc PIC
  429.   Loop 
  430.   Screen Close 2
  431.   Screen Show 0 : If MAINPIC Then Screen Show 1
  432.   Screen 0
  433. Return 
  434. LOAIFF:
  435.   FILEREQ[-1,480,160,-1,"Select an iff picture", Extension_8_02F0(FIFF$), Extension_8_03E0(FIFF$),"","Load","Abort","","P"]
  436.   If Param$="" Then Return 
  437.   FIFF$=Param$
  438.   If Exist(FIFF$)=0
  439.     REQUEST["File does not exist!","Sorry."]
  440.     Return 
  441.   End If 
  442.   Trap Load Iff FIFF$,1
  443.   If Errtrap
  444.     REQUEST["Error while loading iff file!","What a pity :-("]
  445.     MAINPIC=0
  446.     Trap Screen Close 1
  447.     Return 
  448.   End If 
  449.   SCX=Screen Width : SCY=Screen Height : SCC=Screen Colour
  450.   SCR=Screen Mode
  451.   Screen Display 1,128,125,SCX,SCY
  452.   If SCC=4096
  453.     REQUEST["Can't use HAM pictures!","What a pity :-("]
  454.     MAINPIC=0
  455.     Screen Close 1
  456.     Return 
  457.   End If 
  458.   MAINPIC=1
  459.   Screen 0
  460. Return 
  461. LOABACKGROUND:
  462.   If MAINPIC=0 Then REQUEST["Load a main picture first!","Ok"] : Return 
  463.   FILEREQ[-1,480,160,-1,"Select an iff file as background picture", Extension_8_02F0(FIFF$), Extension_8_03E0(FIFF$),"","Load","Abort","","P"]
  464.   If Param$="" Then Return 
  465.   FIFF$=Param$
  466.   If Exist(FIFF$)=0
  467.     REQUEST["File does not exist!","Sorry."]
  468.     Return 
  469.   End If 
  470.   Trap Load Iff FIFF$,2
  471.   If Errtrap
  472.     REQUEST["Error while loading iff file!","What a pity :-("]
  473.     Return 
  474.   End If 
  475.   BSCX=Screen Width : BSCY=Screen Height : BSCC=Screen Colour
  476.   BSCR=Screen Mode
  477.   Screen Display 2,128,125,BSCX,BSCY
  478.   If BSCC=4096
  479.     REQUEST["Can't use HAM pictures!","What a pity :-("]
  480.     BACKPIC=0
  481.     Screen Close 2
  482.     Return 
  483.   End If 
  484.   Screen 0
  485.   REQUEST["Remap picture to foreground palette?","Yes|No"]
  486.   If Param=0
  487.     If SCC>16
  488.       Screen Open 3,SCX,SCY,SCC,SCR
  489.       Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 0
  490.       Screen Display 3,128,125,BSCX,BSCY
  491.       Get Palette 1
  492.     Else 
  493.       REQUEST["Change number of colors to 32?","Yes|No"]
  494.       If Param=1
  495.         Screen Open 3,SCX,SCY,SCC,SCR
  496.         Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 0
  497.         Screen Display 3,128,125,BSCX,BSCY
  498.         Get Palette 1
  499.       Else 
  500.         Screen Open 3,SCX,SCY,32,SCR
  501.         Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 0
  502.         Screen Display 3,128,125,BSCX,BSCY
  503.         Get Palette 1
  504.         Screen Copy 1 To 3
  505.         Screen Open 1,SCX,SCY,32,SCR
  506.         Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 0
  507.         Get Palette 3
  508.         Screen Display 1,128,125,SCX,SCY
  509.         Screen Copy 3 To 1
  510.         Screen To Front 3
  511.         Screen 3
  512.         Cls 
  513.         P=SCC : THRES=10
  514.         For THRES=10 To 1 Step -1
  515.           For A=0 To BSCC-1
  516.             Screen 2 : C0=Colour(A)
  517.             C0R= Extension_8_03B2(C0)
  518.             C0G= Extension_8_03C0(C0)
  519.             C0B= Extension_8_03D0(C0)
  520.             Screen 3 : D=48
  521.             For B=0 To P
  522.               C1=Colour(B)
  523.               C1R= Extension_8_03B2(C1)
  524.               C1G= Extension_8_03C0(C1)
  525.               C1B= Extension_8_03D0(C1)
  526.               D=Min(D,Abs(C1R-C0R)+Abs(C1G-C0G)+Abs(C1B-C0B))
  527.             Next 
  528.             If D>THRES : Colour P,C0 : Inc P : End If 
  529.             Exit If P>31,2
  530.           Next 
  531.         Next 
  532.         SCC=32
  533.         Screen 1 : Get Palette 3
  534.       End If 
  535.     End If 
  536.     Screen Display 3,128,125,SCX,SCY
  537.     Screen Hide 2
  538.     For Y=0 To SCY-1
  539.       For X=0 To SCX-1
  540.         Screen 2 : C=Colour(Max( Extension_8_039E(X,Y),0))
  541.         Screen 3 : Extension_8_0388 X,Y, Extension_8_1504(C)
  542.       Next 
  543.     Next 
  544.   Else 
  545.     Screen Open 3,SCX,SCY,SCC,SCR
  546.     Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 0
  547.     Get Palette 1
  548.     Screen Display 3,128,125,SCX,SCY
  549.     Screen Hide 2
  550.     Screen Copy 2 To 3
  551.   End If 
  552.   Screen Close 2
  553.   Screen Hide 3 : BACKPIC=1
  554.   Screen 0
  555. Return 
  556. KILGADS:
  557.   For A=25 To 60
  558.     DISGAD[A]
  559.   Next 
  560. Return 
  561. DITHER:
  562. Data $0,$8,$2,$A
  563. Data $C,$4,$E,$6
  564. Data $3,$B,$1,$9
  565. Data $E,$7,$D,$5
  566.  
  567. Data $5,$C,$E,$3
  568. Data $8,$0,$6,$A
  569. Data $D,$2,$4,$E
  570. Data $7,$B,$9,$1
  571.  
  572. Procedure ARC[DX,DY]
  573.   If DX<>0
  574.     W=(Atan(((DY*256)/DX)/256.0)*1024.0)/360
  575.   Else 
  576.     If DY<0
  577.       W=256
  578.     Else 
  579.       W=768
  580.     End If 
  581.   End If 
  582.   If DX>0 Then Add W,512
  583. End Proc[W]
  584. Procedure FILEREQNOTIFY
  585.   Shared FIL$()
  586.   FIL$(0)=""
  587. End Proc
  588. Procedure FILEREQ[SN,SX,SY,YP,T$,F$,D$,PAT$,OK$,FAIL$,FON$,OP$]
  589.   FF$=Fsel$(D$,F$,T$,"")
  590. Pop Proc[FF$]
  591.   Shared FIL$(),MXFILES
  592.   OTH=TH : OLDSCR=Screen
  593.   Gosub INIT
  594.   Gosub SETUPSCREEN
  595.   Gosub REFRESH
  596.   Multi Wait : Limit Mouse 
  597.   OMK=0 : EXA=0 : ENT=0
  598.   Do 
  599.     If Timer>25 and RDIR=1
  600.       Sort FIL$(0)
  601.       Gosub REFRESH
  602.       Timer=0
  603.     End If 
  604.     Repeat 
  605.       If RDIR Then Gosub EXAMINDIR Else Multi Wait 
  606.     Until Amos Here
  607.     XM=X Screen(X Mouse) : YM=Y Screen(Y Mouse) : MK=Mouse Key : I$=Inkey$
  608.     If MK=2 Then Gosub DEVLIST
  609.     If I$<>"" and ENT>0
  610.       STRGAD[ENT,I$]
  611.       If Param=-1
  612.         If ENT=6
  613.           F$=Mid$(FB$(6),2) : BT=4
  614.           FIL$(0)= Extension_8_08C4(FILOFF)+ Extension_8_08C4(MXNAMLEN)+RDIR$
  615.           Exit 
  616.         End If 
  617.         If ENT=7
  618.           DD$=D$
  619.           D$=Mid$(FB$(7),2)
  620.           If Exist(D$)
  621.             Gosub NEWREAD
  622.           Else 
  623.             REQUEST["Directory "+D$+" not found!","Oh sorry!"]
  624.             D$=DD$
  625.             NEWTEX[7,"{"+D$]
  626.           End If 
  627.         End If 
  628.         If ENT=8
  629.           PAT$=Mid$(FB$(8),2)
  630.           Gosub NEWREAD
  631.         End If 
  632.         ENT=0
  633.       End If 
  634.     End If 
  635.     BT=0
  636.     If MK=1 and OMK<>1
  637.       CHKMOUSE[XM,YM,1,15]
  638.       BT=Param
  639.     End If 
  640.     If BT and ENT Then NEWTEX[ENT,FB$(ENT)] : ENT=0
  641.     If BT=1 Then Gosub DRAGSCREEN
  642.     If BT=11 Then Gosub SELECT
  643.     If BT=2 or BT=4 or BT=5
  644.       If RDIR
  645.         FIL$(0)=""
  646.       Else 
  647.         FIL$(0)= Extension_8_08C4(FILOFF)+ Extension_8_08C4(MXNAMLEN)+RDIR$
  648.       End If 
  649.       Exit 
  650.     End If 
  651.     If BT=3 Then Amos To Back 
  652.     If BT>5 and BT<9 Then ENT=BT : STRGAD[BT,""]
  653.     If BT=9 Then Gosub DEVLIST
  654.     If BT=10 Then Gosub PARDIR
  655.     If BT=12 Then Gosub DRAGSLIDER
  656.     If BT=13 Then Gosub ARROWUP
  657.     If BT=14 Then Gosub ARROWDOWN
  658.     If BT=15 Then Gosub FLIPPAGE
  659.     OMK=MK
  660.   Loop 
  661.   Screen Close SN
  662.   For A=1 To 15
  663.     DISGAD[A]
  664.   Next 
  665.   If BT=4 Then A$= Extension_8_03EC(D$)+F$ Else A$=""
  666.   TH=OTH
  667.   Trap Screen OLDSCR
  668.   Trap Limit Mouse 
  669. Pop Proc[A$]
  670. INIT:
  671.   If SN<0
  672.     For A=0 To 7
  673.       Trap Screen A
  674.       If Errtrap : SN=A : Exit : End If 
  675.     Next 
  676.   End If 
  677.   If T$="" Then T$="AMCAF File Selector"
  678.   If D$="" Then D$= Extension_8_03E0(Dir$)
  679.   If Instr(OP$,"P") Then PAT=1 Else PAT=0
  680.   If Instr(OP$,"R") Then FIL$(0)=""
  681.   If Instr(OP$,"D") Then DIONLY=1 Else DIONLY=0
  682.   If Instr(OP$,"Q") Then QUICK=1 Else QUICK=0
  683.   If Instr(OP$,"S") Then SAVREQ=1 Else SAVREQ=0
  684.   KICK=Deek(Leek(4)+20)
  685.   If KICK<37 Then PAT=0
  686.   SX=Max(Min((SX+15) and $FFE0,640),160)
  687.   SY=Max(Min(SY,256),96)
  688.   If YP<40 Then YP=168-SY/2
  689.   If FIL$(0)<>""
  690.     RDIR$=Mid$(FIL$(0),5)
  691.     If D$<>RDIR$
  692.       FIL$(0)=""
  693.       RDIR=1 : NUMFIL=0 : FILOFF=0 : SELFIL=-1
  694.       Return 
  695.     Else 
  696.       SELFIL=-1
  697.       FILOFF= Extension_8_098C(FIL$(0))
  698.     End If 
  699.     For A=1 To MXFILES
  700.       Exit If FIL$(A)=Chr$(255)
  701.     Next 
  702.     NUMFIL=A-1
  703.     MXNAMLEN= Extension_8_098C(Mid$(FIL$(0),3))
  704.     RDIR=0
  705.   Else 
  706.     RDIR=1 : NUMFIL=0 : FILOFF=0 : SELFIL=-1
  707.     MXNAMLEN=0
  708.   End If 
  709. Return 
  710. SETUPSCREEN:
  711.   Screen Open SN,SX,SY,4,$8000
  712.   Curs Off : Flash Off : Paper 2 : Pen 1 : Cls 0
  713.   Palette 0,$FFF,$AAA,$666
  714.   Colour 17,$BDF : Colour 18,$6F : Colour 19,$12
  715.   Screen Display SN,288-SX/4,YP,SX,SY
  716.   If FON$<>""
  717.     A=Val(Left$(FON$,2))
  718.     If A>0
  719.       Trap Extension_8_05B0 Mid$(FON$,3),A
  720.       If Errtrap=0
  721.         TH=A
  722.       End If 
  723.     End If 
  724.   End If 
  725.   Gr Writing 0
  726.   DEFCLOWIN[2,0,0]
  727.   FILBOX[0,TH+3,SX-1,SY-1,0]
  728.   DEFTEX[1,19,0,SX-24,TH+2,"{"+T$,3]
  729.   DEFSCRTBK[3,SX-23,0]
  730.   A=Text Length("Pattern:")+8
  731.   If DIONLY=0
  732.     DEFTEX[6,A,SY-TH*2-9,SX-5,SY-TH-7,"{"+F$,7]
  733.     TEX[4,FB(6,1),FB(6,0),FB(6,3),"}File:"]
  734.     FY2=SY-TH*3-13
  735.   Else 
  736.     FY2=SY-TH*2-9
  737.   End If 
  738.   DEFTEX[7,A,FY2,SX-5,FY2+TH+2,"{"+D$,7]
  739.   TEX[4,FB(7,1),FB(7,0),FB(7,3),"}Dir:"]
  740.   If PAT
  741.     DEFTEX[8,A,FY2-TH-4,SX-5,FY2-2,"{"+PAT$,7]
  742.     TEX[4,FB(8,1),FB(8,0),FB(8,3),"}Pattern:"]
  743.     FY2=FB(8,1)-2
  744.   Else 
  745.     FY2=FB(7,1)-2
  746.   End If 
  747.   DEFTEX[4,4,SY-TH-5,SX/4-2,SY-3,OK$,1]
  748.   DEFTEX[9,SX/4+1,SY-TH-5,SX/2-3,SY-3,"Devices",1]
  749.   DEFTEX[10,SX/2,SY-TH-5,SX/2+SX/4-4,SY-3,"Parent",1]
  750.   If Right$(D$,1)=":" Then DEAGAD[10]
  751.   DEFTEX[5,SX/2+SX/4-1,SY-TH-5,SX-5,SY-3,FAIL$,1]
  752.   DEFARROWU[13,SX-22,FY2-17]
  753.   DEFARROWD[14,SX-22,FY2-8]
  754.   D=(FY2-TH-9)
  755.   MXLIN=D/TH
  756.   FY1=TH+7+(D-TH*MXLIN)/2
  757.   DEFBOX[15,SX-22,TH+5,SX-5,FY2-18,3]
  758.   DRASLIDER[15,FILOFF,MXLIN,NUMFIL,12]
  759. Return 
  760. PARDIR:
  761.   If Right$(D$,1)=":" Then Return 
  762.   If RDIR Then Extension_8_0660 
  763.   D$= Extension_8_03E0(D$)
  764.   Gosub NEWREAD
  765. Return 
  766. NEWREAD:
  767.   If RDIR Then Extension_8_0660 
  768.   NEWTEX[7,"{"+D$]
  769.   EXA=0 : RDIR=1 : Gosub EXAMINDIR
  770.   If Right$(D$,1)=":" Then DEAGAD[10] Else ACTGAD[10]
  771.   ACTGAD[9]
  772. Return 
  773. DEVLIST:
  774.   If RDIR=1 or Left$(FIL$(NUMFIL),1)=>"A" Then Return 
  775.   FILOFF=NUMFIL
  776.   F$=Dev First$("")
  777.   While NUMFIL<MXFILES and(F$<>"")
  778.     F$=Mid$(F$,2,Instr(F$,":")-1)
  779.     TYP= Extension_8_02D0(F$)
  780.     If TYP=0
  781.       MXNAMLEN=Max(MXNAMLEN,Len(F$))
  782.       Request Off 
  783.       Trap Extension_8_0672 F$
  784.       A=Errtrap
  785.       Request On 
  786.       If A=0
  787.         NAM$= Extension_8_06D8 
  788.         SOR$="A"+Upper$(F$)+Chr$(0)+"  <Dev> "+F$+Chr$(0)+" ("+NAM$+") "
  789.       Else 
  790.         SOR$="A"+Upper$(F$)+Chr$(0)+"  <Dev> "+F$+Chr$(0)+" "+ Extension_8_0522( Extension_8_0532 )
  791.       End If 
  792.       Inc NUMFIL
  793.       FIL$(NUMFIL)=SOR$
  794.     End If 
  795.     If TYP=1
  796.       MXNAMLEN=Max(MXNAMLEN,Len(F$))
  797.       Inc NUMFIL
  798.       FIL$(NUMFIL)="B"+Upper$(F$)+Chr$(0)+"  <Dir> "+F$+Chr$(0)+" Assign"
  799.     End If 
  800.     F$=Dev Next$
  801.   Wend 
  802.   Sort FIL$(0)
  803.   FILOFF=Min(FILOFF,NUMFIL-MXLIN)
  804.   Gosub REFRESH
  805.   DEAGAD[9]
  806. Return 
  807. SELECT:
  808.   Y=YM-FY1
  809.   If Y<0 or Y>=FY1+MXLIN*TH Then Return 
  810.   F=Y/TH+FILOFF+1
  811.   If F>NUMFIL Then Return 
  812.   TYP=Asc(FIL$(F))
  813.   A$=Peek$(Varptr(FIL$(F))+Instr(FIL$(F),Chr$(0))+8,40,Chr$(0))
  814.   If TYP=32
  815.     D$= Extension_8_03EC(D$)+A$
  816.     Gosub NEWREAD
  817.   End If 
  818.   If TYP=45
  819.     F$=A$
  820.     NEWTEX[6,"{"+F$]
  821.     If SELFIL<>F
  822.       If SELFIL-FILOFF=>0 and SELFIL-FILOFF<=MXLIN
  823.         A=SELFIL-FILOFF-1 : SELFIL=-1
  824.         Gosub LISTFILE
  825.       End If 
  826.       SELFIL=F : A=SELFIL-FILOFF-1 : Timer=0
  827.       Gosub LISTFILE
  828.     Else 
  829.       If Timer<50 and SAVREQ=0
  830.         BT=4
  831.       End If 
  832.     End If 
  833.   End If 
  834.   If TYP=65 or TYP=66
  835.     D$=A$ : Gosub NEWREAD
  836.   End If 
  837. Return 
  838. DRAGSCREEN:
  839.   PUSHGAD[BT]
  840.   A=YM
  841.   Limit Mouse X Hard(0),40+A To X Hard(SX-1),296-SY+A
  842.   Repeat 
  843.     If RDIR : Gosub EXAMINDIR : Else Multi Wait : End If 
  844.     YM=Y Screen(Y Mouse)-A : MK=Mouse Key : I$=Inkey$
  845.     Add YP,YM
  846.     Screen Display SN,,YP,,
  847.   Until MK<>1
  848.   Multi Wait : Limit Mouse 
  849.   OMK=1
  850.   RELEGAD[BT]
  851. Return 
  852. ARROWUP:
  853.   PUSHGAD[BT]
  854.   Repeat 
  855.     Multi Wait 
  856.     MK=Mouse Key : I$=Inkey$
  857.     If FILOFF>0
  858.       Dec FILOFF
  859.       Gosub SCROLFILES
  860.     End If 
  861.   Until MK<>1
  862.   RELEGAD[BT]
  863. Return 
  864. ARROWDOWN:
  865.   PUSHGAD[BT]
  866.   Repeat 
  867.     Multi Wait 
  868.     MK=Mouse Key : I$=Inkey$
  869.     If FILOFF<NUMFIL-MXLIN
  870.       Inc FILOFF
  871.       Gosub SCROLFILES
  872.     End If 
  873.   Until MK<>1
  874.   RELEGAD[BT]
  875. Return 
  876. DRAGSLIDER:
  877.   DISGAD[12]
  878.   O=YM-FB(12,1)
  879.   Repeat 
  880.     Multi Wait 
  881.     XM=X Screen(X Mouse) : YM=Y Screen(Y Mouse) : MK=Mouse Key : I$=Inkey$
  882.     DRAGSLIDER[15,YM-O,MXLIN,NUMFIL,12]
  883.     If NUMFIL>MXLIN
  884.       FILOFF=Param
  885.       Gosub SCROLFILES
  886.     End If 
  887.   Until MK<>1
  888.   ENAGAD[12]
  889.   DRASLIDER[15,FILOFF,MXLIN,NUMFIL,12]
  890.   OMK=1
  891. Return 
  892. REFRESH:
  893.   DEFBOX[11,4,TH+5,SX-25,FY2,7]
  894.   If NUMFIL>0
  895.     For A=0 To Min(MXLIN-1,NUMFIL-1)
  896.       Gosub LISTFILE
  897.     Next 
  898.     OLDOFF=FILOFF
  899.   End If 
  900.   If FB(12,4) and 1 Then DRASLIDER[15,FILOFF,MXLIN,NUMFIL,12]
  901. Return 
  902. SCROLFILES:
  903.   If OLDOFF=FILOFF Then Return 
  904.   X1=FB(11,0)+2 : X2=FB(11,2)-2 : Y1=FY1+1 : Y2=FY1+TH*MXLIN+1
  905.   D=FILOFF-OLDOFF
  906.   If Abs(D)>MXLIN-2 Then Gosub REFRESH : Return 
  907.   If D>0
  908.     Screen Copy SN,X1,Y1+D*TH,X2,Y2 To SN,X1,Y1
  909.     For A=MXLIN-D To MXLIN-1
  910.       Gosub LISTFILE
  911.     Next 
  912.   Else 
  913.     Screen Copy SN,X1,Y1,X2,Y2+D*TH To SN,X1,Y1-D*TH
  914.     For A=0 To -D-1
  915.       Gosub LISTFILE
  916.     Next 
  917.   End If 
  918.   OLDOFF=FILOFF
  919.   If FB(12,4) and 1 Then DRASLIDER[15,FILOFF,MXLIN,NUMFIL,12]
  920. Return 
  921. FLIPPAGE:
  922.   If NUMFIL<MXLIN Then Return 
  923.   If YM>(FB(12,1)+FB(12,3))/2
  924.     FILOFF=Min(FILOFF+MXLIN,NUMFIL-MXLIN)
  925.   Else 
  926.     FILOFF=Max(FILOFF-MXLIN,0)
  927.   End If 
  928.   Gosub REFRESH
  929.   DRASLIDER[15,FILOFF,MXLIN,NUMFIL,12]
  930. Return 
  931. LISTFILE:
  932.   If QUICK
  933.     A$=FIL$(A+FILOFF+1)
  934.     A$=Peek$(Varptr(A$)+Instr(A$,Chr$(0)),40,Chr$(0))
  935.   Else 
  936.     A$=FIL$(A+FILOFF+1)
  937.     B$=Mid$(A$,Instr(A$,Chr$(0))+1)
  938.     FIL$=Left$(B$,Instr(B$,Chr$(0))-1)
  939.     RES$=Mid$(B$,Len(FIL$)+2)
  940.     A$=FIL$+Space$(MXNAMLEN-(Len(FIL$)-8))+RES$
  941.   End If 
  942.   If Asc(FIL$(A+FILOFF+1))<>45
  943.     TEX2[6,FY1+A*TH,SX-28,FY1+(A+1)*TH+1,"{"+A$]
  944.   Else 
  945.     TEX[6,FY1+A*TH,SX-28,FY1+(A+1)*TH+1,"{"+A$]
  946.   End If 
  947.   If A+FILOFF+1=SELFIL
  948.     Gr Writing 2
  949.     Ink 2 : Bar 8,FY1+A*TH+1 To SX-29,FY1+(A+1)*TH
  950.     Gr Writing 0
  951.   End If 
  952. Return 
  953. EXAMINDIR:
  954.   If EXA=0
  955.     FILOFF=0 : NUMFIL=0 : MXNAMLEN=5 : RDIR$=D$
  956.     SELFIL=-1
  957.     For A=1 To MXFILES
  958.       FIL$(A)=Chr$(255)
  959.     Next 
  960.     Trap Extension_8_063A D$
  961.     If Errtrap=0
  962.       EXA=1 : Timer=0
  963.     Else 
  964.       Gosub REFRESH
  965.       REQUEST[ Extension_8_0522( Extension_8_0532 )+"!","Cancel"]
  966.       RDIR=0 : Return 
  967.     End If 
  968.   End If 
  969.   If NUMFIL=MXFILES
  970.      Extension_8_0660 
  971.     Sort FIL$(0)
  972.     RDIR=0
  973.     Gosub REFRESH
  974.     Return 
  975.   End If 
  976.   FIL$= Extension_8_064C 
  977.   If FIL$=""
  978.     Sort FIL$(0)
  979.     Timer=0 : RDIR=0 : Gosub REFRESH
  980.     Return 
  981.   End If 
  982.   TYP= Extension_8_0688 
  983.   If QUICK=0
  984.     DATE$=Mid$( Extension_8_0F0A( Extension_8_06F4 ),4)+" "+ Extension_8_0F1A( Extension_8_070E )
  985.     COM$= Extension_8_0762 
  986.     FLAG$= Extension_8_0728( Extension_8_0742 )
  987.   End If 
  988.   If TYP<0
  989.     If DIONLY=0
  990.       If KICK>36
  991.         A= Extension_8_0300(FIL$,PAT$)
  992.       Else 
  993.         A=-1
  994.       End If 
  995.     Else 
  996.       A=0
  997.     End If 
  998.     If A
  999.       MXNAMLEN=Max(MXNAMLEN,Len(FIL$))
  1000.       SIZE$= Extension_8_0EC8( Extension_8_06A2 ,7)
  1001.       Inc NUMFIL
  1002.       If QUICK
  1003.         FIL$(NUMFIL)="-"+Upper$(FIL$)+Chr$(0)+SIZE$+" "+FIL$+Chr$(0)
  1004.       Else 
  1005.         SOR$="-"+Upper$(FIL$)+Chr$(0)+SIZE$+" "+FIL$+Chr$(0)+DATE$+" "+FLAG$+" "+COM$
  1006.         FIL$(NUMFIL)=SOR$
  1007.       End If 
  1008.     End If 
  1009.   Else 
  1010.     MXNAMLEN=Max(MXNAMLEN,Len(FIL$))
  1011.     Inc NUMFIL
  1012.     If QUICK
  1013.       FIL$(NUMFIL)=" "+Upper$(FIL$)+Chr$(0)+"  <Dir> "+FIL$+Chr$(0)
  1014.     Else 
  1015.       SOR$=" "+Upper$(FIL$)+Chr$(0)+"  <Dir> "+FIL$+Chr$(0)+DATE$+" "+FLAG$+" "+COM$
  1016.       FIL$(NUMFIL)=SOR$
  1017.     End If 
  1018.   End If 
  1019. Return 
  1020. End Proc
  1021. Procedure REQUEST[T$,OP$]
  1022.   Dim LIN$(20)
  1023.   OPT=1 : OTH=TH
  1024.   For A=1 To Len(OP$)
  1025.     If Mid$(OP$,A,1)="|" Then Inc OPT
  1026.   Next 
  1027.   If Screen=-1
  1028.     TH=8
  1029.     SX=Max(Len(OP$)*8+OPT*32+8+15,320) and $FE0
  1030.     LPR=SX/8-2
  1031.   Else 
  1032.     SX=Max(Text Length(OP$)+OPT*32+8+15,320) and $FE0
  1033.     LPR=SX/Text Length("M")-2
  1034.   End If 
  1035.   LI=0 : LP=1 : LILE=0
  1036.   For A=1 To Len(T$)
  1037.     P=Asc(Mid$(T$,A,1))
  1038.     Inc LILE
  1039.     If LILE>LPR
  1040.       LIN$(LI)=Mid$(T$,LP,SP-LP+1)
  1041.       LP=SP+2 : LILE=A-LP
  1042.       Inc LI
  1043.     End If 
  1044.     If P=32 Then SP=A-1
  1045.     If P=167 Then LILE=LPR+2 : SP=A-1
  1046.   Next 
  1047.   LIN$(LI)=Mid$(T$,LP) : Inc LI
  1048.   NBLI=LI-1
  1049.   SY=32+LI*TH
  1050.   If Screen=-1
  1051.     SN=0
  1052.     Screen Open SN,SX,SY,4,$8000
  1053.     Curs Off : Flash Off : Paper 2 : Pen 1 : Cls 0
  1054.     Palette 0,$FFF,$AAA,$666
  1055.     Colour 17,$BDF : Colour 18,$6F : Colour 19,$12
  1056.     Screen Display SN,288-SX/4,168-SY/2,SX,SY
  1057.     Gr Writing 0
  1058.     Wait Vbl : Limit Mouse 
  1059.     OLDSCR=-1
  1060.     XP=0 : YP=0
  1061.   Else 
  1062.     If Screen Height<SY+4 or Screen Width<SX+16 or Screen Colour<4
  1063.       OLDSCR=Screen
  1064.       For A=0 To 7
  1065.         Trap Screen A
  1066.         If Errtrap : SN=A : Exit : End If 
  1067.       Next 
  1068.       Screen Open SN,SX,SY,4,$8000
  1069.       Curs Off : Flash Off : Paper 2 : Pen 1 : Cls 0
  1070.       Get Palette OLDSCR
  1071.       Screen Display SN,288-SX/4,168-SY/2,SX,SY
  1072.       Gr Writing 0
  1073.       Wait Vbl : Limit Mouse 
  1074.       XP=0 : YP=0
  1075.     Else 
  1076.       XP=(Screen Width-SX)/2
  1077.       YP=(Screen Height-SY)/2
  1078.       SN=-1
  1079.       Get Cblock 9,XP-4,YP-2,SX+16,SY+4
  1080.       DRABOX[XP-4,YP-2,XP+SX+3,YP+SY+1,0]
  1081.       DRABOX[XP-2,YP-1,XP+SX+1,YP+SY,1]
  1082.       Limit Mouse X Hard(XP),Y Hard(YP) To X Hard(XP+SX-1),Y Hard(YP+SY-1)
  1083.     End If 
  1084.   End If 
  1085.   FILBOX[XP,YP,XP+SX-1,YP+SY-1,0]
  1086.   For A=0 To NBLI
  1087.     TEX[XP+4,YP+4+A*TH,XP+SX-5,YP+12+A*TH,LIN$(A)]
  1088.   Next 
  1089.   OP=0
  1090.   For A=1 To OPT
  1091.     NP=Instr(OP$,"|",OP+1) : If NP=0 Then NP=Len(OP$)+1
  1092.     T$=Mid$(OP$,OP+1,NP-OP-1)
  1093.     X1=XP+4+((A-1)*(SX-6))/OPT
  1094.     X2=XP+1+(A*(SX-6))/OPT
  1095.     DEFTEX[15+A,X1,YP+SY-TH-14,X2,YP+SY-3,T$,1]
  1096.     OP=NP
  1097.   Next 
  1098.   OMK=0
  1099.   Do 
  1100.     Repeat : Multi Wait : Until Amos Here
  1101.     XM=X Screen(X Mouse) : YM=Y Screen(Y Mouse) : MK=Mouse Key : I$=Inkey$
  1102.     BT=0
  1103.     If MK=1 and OMK<>1
  1104.       CHKMOUSE[XM,YM,16,15+OPT]
  1105.       BT=Param
  1106.     End If 
  1107.     Exit If BT
  1108.     OMK=MK
  1109.   Loop 
  1110.   For A=1 To OPT
  1111.     DISGAD[15+A]
  1112.   Next 
  1113.   Limit Mouse 
  1114.   If SN>-1
  1115.     Screen Close SN
  1116.     If OLDSCR>-1
  1117.       Screen OLDSCR
  1118.     End If 
  1119.   Else 
  1120.     Put Cblock 9
  1121.     Del Cblock 9
  1122.   End If 
  1123.   TH=OTH
  1124. End Proc[BT-16]
  1125. Procedure NUMENT[T$,OP$,DEFNUM,LOWER,UPPER]
  1126.   Dim LIN$(10)
  1127.   OPT=1 : OTH=TH
  1128.   For A=1 To Len(OP$)
  1129.     If Mid$(OP$,A,1)="|" Then Inc OPT
  1130.   Next 
  1131.   If Screen=-1
  1132.     TH=8
  1133.     SX=Max(Len(OP$)*8+OPT*32+8+15,320) and $FE0
  1134.     LPR=SX/8-2
  1135.   Else 
  1136.     SX=Max(Text Length(OP$)+OPT*32+8+15,320) and $FE0
  1137.     LPR=SX/Text Length("M")-2
  1138.   End If 
  1139.   LI=0 : LP=1 : LILE=0
  1140.   For A=1 To Len(T$)
  1141.     P=Asc(Mid$(T$,A,1))
  1142.     Inc LILE
  1143.     If LILE>LPR
  1144.       LIN$(LI)=Mid$(T$,LP,SP-LP+1)
  1145.       LP=SP+2 : LILE=A-LP
  1146.       Inc LI
  1147.     End If 
  1148.     If P=32 Then SP=A-1
  1149.     If P=167 Then LILE=LPR+2 : SP=A-1
  1150.   Next 
  1151.   LIN$(LI)=Mid$(T$,LP) : Inc LI
  1152.   NBLI=LI-1
  1153.   SY=48+LI*TH
  1154.   If Screen=-1
  1155.     SN=0
  1156.     Screen Open SN,SX,SY,4,$8000
  1157.     Curs Off : Flash Off : Paper 2 : Pen 1 : Cls 0
  1158.     Palette 0,$FFF,$AAA,$666
  1159.     Colour 17,$BDF : Colour 18,$6F : Colour 19,$12
  1160.     Screen Display SN,288-SX/4,168-SY/2,SX,SY
  1161.     Gr Writing 0
  1162.     Wait Vbl : Limit Mouse 
  1163.     OLDSCR=-1
  1164.     XP=0 : YP=0
  1165.   Else 
  1166.     If Screen Height<SY or Screen Width<SX or Screen Colour<4
  1167.       For A=0 To 7
  1168.         Trap Screen A
  1169.         If Errtrap : SN=A : Exit : End If 
  1170.       Next 
  1171.       OLDSCR=Screen
  1172.       Screen Open SN,SX,SY,4,$8000
  1173.       Curs Off : Flash Off : Paper 2 : Pen 1 : Cls 0
  1174.       Get Palette OLDSCR
  1175.       Screen Display SN,288-SX/4,168-SY/2,SX,SY
  1176.       Gr Writing 0
  1177.       Wait Vbl : Limit Mouse 
  1178.       XP=0 : YP=0
  1179.     Else 
  1180.       XP=(Screen Width-SX)/2
  1181.       YP=(Screen Height-SY)/2
  1182.       SN=-1
  1183.       Get Cblock 9,XP-4,YP-2,SX+16,SY+4
  1184.       DRABOX[XP-4,YP-2,XP+SX+3,YP+SY+1,0]
  1185.       DRABOX[XP-2,YP-1,XP+SX+1,YP+SY,1]
  1186.       Limit Mouse X Hard(XP),Y Hard(YP) To X Hard(XP+SX-1),Y Hard(YP+SY-1)
  1187.     End If 
  1188.   End If 
  1189.   FILBOX[XP,YP,XP+SX-1,YP+SY-1,0]
  1190.   For A=0 To NBLI
  1191.     TEX[XP+4,YP+4+A*TH,XP+SX-5,YP+12+A*TH,LIN$(A)]
  1192.   Next 
  1193.   DEFTEX[16,XP+4,YP+SY-TH*2-18,XP+SX-5,YP+SY-TH-16,"{"+Mid$(Str$(DEFNUM),2),7]
  1194.   OP=0
  1195.   For A=1 To OPT
  1196.     NP=Instr(OP$,"|",OP+1) : If NP=0 Then NP=Len(OP$)+1
  1197.     T$=Mid$(OP$,OP+1,NP-OP-1)
  1198.     X1=XP+4+((A-1)*(SX-6))/OPT
  1199.     X2=XP+1+(A*(SX-6))/OPT
  1200.     DEFTEX[16+A,X1,YP+SY-TH-14,X2,YP+SY-3,T$,1]
  1201.     OP=NP
  1202.   Next 
  1203.   OMK=0
  1204.   STRGAD[16,""]
  1205.   Do 
  1206.     Repeat : Multi Wait : Until Amos Here
  1207.     XM=X Screen(X Mouse) : YM=Y Screen(Y Mouse) : MK=Mouse Key : I$=Inkey$
  1208.     BT=17
  1209.     If I$<>""
  1210.       If I$<" " or(I$>="0" and I$<="9")
  1211.         If Not(I$="0" and NUM=0)
  1212.           STRGAD[16,I$]
  1213.           Exit If Param=-1
  1214.         End If 
  1215.       End If 
  1216.     End If 
  1217.     NUM=Val(Mid$(FB$(16),2))
  1218.     If NUM<LOWER
  1219.       NUM=LOWER
  1220.       NEWTEX[16,"{"+Mid$(Str$(NUM),2)]
  1221.       STRGAD[16,""]
  1222.     End If 
  1223.     If NUM>UPPER
  1224.       NUM=UPPER
  1225.       NEWTEX[16,"{"+Mid$(Str$(NUM),2)]
  1226.       STRGAD[16,""]
  1227.     End If 
  1228.     BT=0
  1229.     If MK=1 and OMK<>1
  1230.       CHKMOUSE[XM,YM,16,16+OPT]
  1231.       BT=Param
  1232.     End If 
  1233.     Exit If BT>16
  1234.     OMK=MK
  1235.   Loop 
  1236.   For A=1 To OPT+1
  1237.     DISGAD[15+A]
  1238.   Next 
  1239.   Limit Mouse 
  1240.   If SN>-1
  1241.     Screen Close SN
  1242.     If OLDSCR>-1
  1243.       Screen OLDSCR
  1244.     End If 
  1245.   Else 
  1246.     Put Cblock 9
  1247.     Del Cblock 9
  1248.   End If 
  1249.   TH=OTH
  1250.   A$= Extension_8_0EB8(BT-17,1)+Mid$(Str$(NUM),2)
  1251. End Proc[A$]
  1252. Procedure TXTENT[T$,OP$,DEFTXT$,NUMLET]
  1253.   Dim LIN$(10)
  1254.   OPT=1 : OTH=TH
  1255.   For A=1 To Len(OP$)
  1256.     If Mid$(OP$,A,1)="|" Then Inc OPT
  1257.   Next 
  1258.   If Screen=-1
  1259.     TH=8
  1260.     SX=Max(Len(OP$)*8+OPT*32+8+15,320) and $FE0
  1261.     LPR=SX/8-2
  1262.   Else 
  1263.     SX=Max(Text Length(OP$)+OPT*32+8+15,320) and $FE0
  1264.     LPR=SX/Text Length("M")-2
  1265.   End If 
  1266.   LI=0 : LP=1 : LILE=0
  1267.   For A=1 To Len(T$)
  1268.     P=Asc(Mid$(T$,A,1))
  1269.     Inc LILE
  1270.     If LILE>LPR
  1271.       LIN$(LI)=Mid$(T$,LP,SP-LP+1)
  1272.       LP=SP+2 : LILE=A-LP
  1273.       Inc LI
  1274.     End If 
  1275.     If P=32 Then SP=A-1
  1276.     If P=167 Then LILE=LPR+2 : SP=A-1
  1277.   Next 
  1278.   LIN$(LI)=Mid$(T$,LP) : Inc LI
  1279.   NBLI=LI-1
  1280.   SY=48+LI*TH
  1281.   If Screen=-1
  1282.     SN=0
  1283.     Screen Open SN,SX,SY,4,$8000
  1284.     Curs Off : Flash Off : Paper 2 : Pen 1 : Cls 0
  1285.     Palette 0,$FFF,$AAA,$666
  1286.     Colour 17,$BDF : Colour 18,$6F : Colour 19,$12
  1287.     Screen Display SN,288-SX/4,168-SY/2,SX,SY
  1288.     Gr Writing 0
  1289.     Wait Vbl : Limit Mouse 
  1290.     OLDSCR=-1
  1291.     XP=0 : YP=0
  1292.   Else 
  1293.     If Screen Height<SY or Screen Width<SX or Screen Colour<4
  1294.       For A=0 To 7
  1295.         Trap Screen A
  1296.         If Errtrap : SN=A : Exit : End If 
  1297.       Next 
  1298.       OLDSCR=Screen
  1299.       Screen Open SN,SX,SY,4,$8000
  1300.       Curs Off : Flash Off : Paper 2 : Pen 1 : Cls 0
  1301.       Get Palette OLDSCR
  1302.       Screen Display SN,288-SX/4,168-SY/2,SX,SY
  1303.       Gr Writing 0
  1304.       Wait Vbl : Limit Mouse 
  1305.       XP=0 : YP=0
  1306.     Else 
  1307.       XP=(Screen Width-SX)/2
  1308.       YP=(Screen Height-SY)/2
  1309.       SN=-1
  1310.       Get Cblock 9,XP-4,YP-2,SX+16,SY+4
  1311.       DRABOX[XP-4,YP-2,XP+SX+3,YP+SY+1,0]
  1312.       DRABOX[XP-2,YP-1,XP+SX+1,YP+SY,1]
  1313.       Limit Mouse X Hard(XP),Y Hard(YP) To X Hard(XP+SX-1),Y Hard(YP+SY-1)
  1314.     End If 
  1315.   End If 
  1316.   FILBOX[XP,YP,XP+SX-1,YP+SY-1,0]
  1317.   For A=0 To NBLI
  1318.     TEX[XP+4,YP+4+A*TH,XP+SX-5,YP+12+A*TH,LIN$(A)]
  1319.   Next 
  1320.   DEFTEX[16,XP+4,YP+SY-TH*2-18,XP+SX-5,YP+SY-TH-16,"{"+DEFTXT$,7]
  1321.   OP=0
  1322.   For A=1 To OPT
  1323.     NP=Instr(OP$,"|",OP+1) : If NP=0 Then NP=Len(OP$)+1
  1324.     T$=Mid$(OP$,OP+1,NP-OP-1)
  1325.     X1=XP+4+((A-1)*(SX-6))/OPT
  1326.     X2=XP+1+(A*(SX-6))/OPT
  1327.     DEFTEX[16+A,X1,YP+SY-TH-14,X2,YP+SY-3,T$,1]
  1328.     OP=NP
  1329.   Next 
  1330.   OMK=0
  1331.   STRGAD[16,""]
  1332.   Do 
  1333.     Repeat : Multi Wait : Until Amos Here
  1334.     XM=X Screen(X Mouse) : YM=Y Screen(Y Mouse) : MK=Mouse Key : I$=Inkey$
  1335.     BT=17
  1336.     If I$<>""
  1337.       STRGAD[16,I$]
  1338.       Exit If Param=-1
  1339.     End If 
  1340.     TXT$=Mid$(FB$(16),2)
  1341.     If Len(TXT$)>NUMLET
  1342.       NEWTEX[16,"{"+Left$(TXT$,NUMLET)]
  1343.       STRGAD[16,""]
  1344.     End If 
  1345.     BT=0
  1346.     If MK=1 and OMK<>1
  1347.       CHKMOUSE[XM,YM,16,16+OPT]
  1348.       BT=Param
  1349.     End If 
  1350.     Exit If BT>16
  1351.     OMK=MK
  1352.   Loop 
  1353.   For A=1 To OPT+1
  1354.     DISGAD[15+A]
  1355.   Next 
  1356.   Limit Mouse 
  1357.   If SN>-1
  1358.     Screen Close SN
  1359.     If OLDSCR>-1
  1360.       Screen OLDSCR
  1361.     End If 
  1362.   Else 
  1363.     Put Cblock 9
  1364.     Del Cblock 9
  1365.   End If 
  1366.   TH=OTH
  1367.   A$= Extension_8_0EB8(BT-17,1)+TXT$
  1368. End Proc[A$]
  1369. Procedure CHKMOUSE[XM,YM,LL,UL]
  1370.   For BT=LL To UL
  1371.     If XM=>FB(BT,0) and XM<=FB(BT,2) and YM=>FB(BT,1) and YM<=FB(BT,3) and(FB(BT,4) and 1) Then Exit 
  1372.   Next 
  1373.   If BT>UL Then Pop Proc[0]
  1374.   If FB(BT,4) and 2 Then Pop Proc[BT]
  1375.   OST=-1 : AA=0
  1376.   ST= Extension_8_093A(FB(BT,4) and 4,2)
  1377.   Repeat 
  1378.     Multi Wait 
  1379.     XM=X Screen(X Mouse) : YM=Y Screen(Y Mouse) : MK=Mouse Key : I$=Inkey$
  1380.     If XM=>FB(BT,0) and XM<=FB(BT,2) and YM=>FB(BT,1) and YM<=FB(BT,3) Then A=1 Else A=0
  1381.     If AA<>A Then AA=A : ST=1-ST
  1382.     If OST<>ST
  1383.       If ST
  1384.         PUSHGAD[BT]
  1385.       Else 
  1386.         RELEGAD[BT]
  1387.       End If 
  1388.       OST=ST
  1389.     End If 
  1390.   Until MK<>1
  1391.   If A=0 Then Pop Proc[0]
  1392.   If ST
  1393.     RELEGAD[BT]
  1394.   Else 
  1395.     PUSHGAD[BT]
  1396.   End If 
  1397. End Proc[BT]
  1398. Procedure DEFTEX[BT,X1,Y1,X2,Y2,T$,FL]
  1399.   TEXBOX[X1,Y1,X2,Y2, Extension_8_093A(FL and 4,2),T$]
  1400.   DEFGAD[BT,X1,Y1,X2,Y2,FL]
  1401.   FB$(BT)=T$
  1402. End Proc
  1403. Procedure DEFBOX[BT,X1,Y1,X2,Y2,FL]
  1404.   FILBOX[X1,Y1,X2,Y2, Extension_8_093A(FL and 4,2)]
  1405.   DEFGAD[BT,X1,Y1,X2,Y2,FL]
  1406. End Proc
  1407. Procedure DEFGAD[BT,X1,Y1,X2,Y2,FL]
  1408.   FB(BT,0)=X1 : FB(BT,1)=Y1
  1409.   FB(BT,2)=X2 : FB(BT,3)=Y2
  1410.   FB(BT,4)=FL
  1411.   FB$(BT)=""
  1412. End Proc
  1413. Procedure DEAGAD[BT]
  1414.   If(FB(BT,4) and 1)=0 Then Pop Proc
  1415.   FB(BT,4)=FB(BT,4) and $FE
  1416.   Set Pattern 2
  1417.   Ink 3 : Bar FB(BT,0),FB(BT,1) To FB(BT,2),FB(BT,3)
  1418.   Set Pattern 0
  1419. End Proc
  1420. Procedure ACTGAD[BT]
  1421.   If FB(BT,4) and 1 Then Pop Proc
  1422.   CLRGAD[BT]
  1423.   FB(BT,4)=FB(BT,4) or 1
  1424.   If FB$(BT)<>""
  1425.     TEXBOX[FB(BT,0),FB(BT,1),FB(BT,2),FB(BT,3), Extension_8_093A(FB(BT,4) and 4,2),FB$(BT)]
  1426.   Else 
  1427.     DRABOX[FB(BT,0),FB(BT,1),FB(BT,2),FB(BT,3), Extension_8_093A(FB(BT,4) and 4,2)]
  1428.   End If 
  1429. End Proc
  1430. Procedure DISGAD[BT]
  1431.   FB(BT,4)=FB(BT,4) and $FE
  1432. End Proc
  1433. Procedure ENAGAD[BT]
  1434.   FB(BT,4)=FB(BT,4) or 1
  1435. End Proc
  1436. Procedure CLRGAD[BT]
  1437.   FB(BT,4)=FB(BT,4) and $FE
  1438.   Ink 2 : Bar FB(BT,0),FB(BT,1) To FB(BT,2),FB(BT,3)
  1439. End Proc
  1440. Procedure PUSHGAD[BT]
  1441.   DRABOX[FB(BT,0),FB(BT,1),FB(BT,2),FB(BT,3),1]
  1442. End Proc
  1443. Procedure RELEGAD[BT]
  1444.   DRABOX[FB(BT,0),FB(BT,1),FB(BT,2),FB(BT,3),0]
  1445. End Proc
  1446. Procedure FILBOX[X1,Y1,X2,Y2,SE]
  1447.   Ink 2 : Bar X1+2,Y1+1 To X2-2,Y2-1
  1448.    Extension_8_0388 X1,Y2,2
  1449.    Extension_8_0388 X2,Y1,2
  1450.   Ink 1+SE*2 : Draw X1,Y2-1 To X1,Y1 : Draw To X2-1,Y1 : Draw X1+1,Y2-1 To X1+1,Y1
  1451.   Ink 3-SE*2 : Draw X1+1,Y2 To X2,Y2 : Draw To X2,Y1+1 : Draw X2-1,Y2 To X2-1,Y1+1
  1452. End Proc
  1453. Procedure NEWTEX[BT,T$]
  1454.   FB$(BT)=T$
  1455.   TEX[FB(BT,0)+1,FB(BT,1),FB(BT,2)-1,FB(BT,3),T$]
  1456. End Proc
  1457. Procedure TEXBOX[X1,Y1,X2,Y2,SE,T$]
  1458.   TEX[X1+1,Y1,X2-1,Y2,T$]
  1459.    Extension_8_0388 X1,Y2,2 : Extension_8_0388 X2,Y1,2
  1460.   Ink 1+SE*2 : Draw X1,Y2-1 To X1,Y1 : Draw To X2-1,Y1 : Draw X1+1,Y2-1 To X1+1,Y1
  1461.   Ink 3-SE*2 : Draw X1+1,Y2 To X2,Y2 : Draw To X2,Y1+1 : Draw X2-1,Y2 To X2-1,Y1+1
  1462. End Proc
  1463. Procedure TEX[X1,Y1,X2,Y2,T$]
  1464.   If Asc(T$)=123
  1465.     M=1 : T$=Mid$(T$,2)
  1466.   Else 
  1467.     If Asc(T$)=125
  1468.       M=2 : T$=Mid$(T$,2)
  1469.     Else 
  1470.       M=0
  1471.     End If 
  1472.   End If 
  1473.   TL=Text Length(T$)
  1474.   While TL>(X2-X1)-4
  1475.     T$=Left$(T$,Len(T$)-1)
  1476.     TL=Text Length(T$)
  1477.   Wend 
  1478.   If M=1
  1479.     X=X1+4 : Y=Y1+1
  1480.   Else 
  1481.     If M=2
  1482.       X=X2-Text Length(T$)-2 : Y=Y1+1
  1483.     Else 
  1484.       X=(X1+X2-TL)/2 : Y=(Y1+Y2-TH+2)/2
  1485.     End If 
  1486.   End If 
  1487.   If Y2>0 Then Ink 2 : Bar X1+1,Y1+1 To X2-1,Y2-1
  1488.   Ink 0 : Text X,Y+Text Base,T$
  1489. End Proc
  1490. Procedure TEX2[X1,Y1,X2,Y2,T$]
  1491.   If Asc(T$)=123
  1492.     M=1 : T$=Mid$(T$,2)
  1493.   Else 
  1494.     If Asc(T$)=125
  1495.       M=2 : T$=Mid$(T$,2)
  1496.     Else 
  1497.       M=0
  1498.     End If 
  1499.   End If 
  1500.   TL=Text Length(T$)
  1501.   While TL>(X2-X1)-4
  1502.     T$=Left$(T$,Len(T$)-1)
  1503.     TL=Text Length(T$)
  1504.   Wend 
  1505.   If M=1
  1506.     X=X1+4 : Y=Y1+1
  1507.   Else 
  1508.     If M=2
  1509.       X=X2-Text Length(T$)-2 : Y=Y1+1
  1510.     Else 
  1511.       X=(X1+X2-TL)/2 : Y=(Y1+Y2-TH+1)/2
  1512.     End If 
  1513.   End If 
  1514.   If Y2>0 Then Ink 2 : Bar X1+1,Y1+1 To X2-1,Y2-1
  1515.   Ink 1 : Text X,Y+Text Base,T$
  1516. End Proc
  1517. Procedure DRABOX[X1,Y1,X2,Y2,SE]
  1518.   Ink 1+SE*2 : Draw X1,Y2-1 To X1,Y1 : Draw To X2-1,Y1 : Draw X1+1,Y2-1 To X1+1,Y1
  1519.   Ink 3-SE*2 : Draw X1+1,Y2 To X2,Y2 : Draw To X2,Y1+1 : Draw X2-1,Y2 To X2-1,Y1+1
  1520. End Proc
  1521. Procedure STRGAD[BT,I$]
  1522.   Shared POS
  1523.   A$=FB$(BT)
  1524.   If I$=""
  1525.     POS=Len(A$)-1
  1526.   End If 
  1527.   If I$>Chr$(31) Then A$=Left$(A$,POS+1)+I$+Mid$(A$,POS+2) : Inc POS
  1528.   If I$=Chr$(8) and POS>0 Then A$=Left$(A$,POS)+Mid$(A$,POS+2) : Dec POS
  1529.   If I$=Cleft$ and POS>0 Then Dec POS
  1530.   If I$=Cright$ and POS<Len(A$)-1 Then Inc POS
  1531.   If I$=Chr$(13)
  1532.     NEWTEX[BT,A$]
  1533.     Pop Proc[-1]
  1534.   End If 
  1535.   NEWTEX[BT,A$]
  1536.   X1=FB(BT,0)+5+Text Length(Mid$(A$,2,POS)) : Y1=FB(BT,1)+1
  1537.   X2=X1+Max(Text Length(Mid$(A$,POS+2,1)),4)
  1538.   If X2<FB(BT,2)-4
  1539.     Gr Writing 2
  1540.     Ink 3 : Bar X1,Y1 To X2-1,Y1+TH-1
  1541.     Gr Writing 0
  1542.   End If 
  1543. End Proc[0]
  1544. Procedure DEFCLOWIN[BT,X,Y]
  1545.   DRACLOWIN[X,Y]
  1546.   DEFGAD[BT,X,Y,X+18,Y+TH+2,1]
  1547. End Proc
  1548. Procedure DRACLOWIN[X,Y]
  1549.   FILBOX[X,Y,X+18,Y+TH+2,0]
  1550.   Ink 0 : Box 7+X,3+Y To 11+X,Y+TH-1
  1551. End Proc
  1552. Procedure DEFSCRTBK[BT,X,Y]
  1553.   DRASCRTBK[X,Y]
  1554.   DEFGAD[BT,X,Y,X+22,Y+TH+2,1]
  1555. End Proc
  1556. Procedure DRASCRTBK[X,Y]
  1557.   FILBOX[X,Y,X+22,Y+TH+2,0]
  1558.   Ink 0 : Box 4+X,2+Y To 14+X,Y+TH/2+2
  1559.   Ink 2 : Bar 8+X,Y+TH/2 To 18+X,Y+TH
  1560.   Ink 0 : Box 8+X,Y+TH/2 To 18+X,Y+TH
  1561. End Proc
  1562. Procedure DEFARROWU[BT,X,Y]
  1563.   DRAARROWU[X,Y]
  1564.   DEFGAD[BT,X,Y,X+17,Y+8,3]
  1565. End Proc
  1566. Procedure DRAARROWU[X,Y]
  1567.   DRABOX[X,Y,X+17,Y+8,0]
  1568.    Extension_8_1016 X+4,Y+6 To X+8,Y+2,0
  1569.    Extension_8_1016 X+5,Y+6 To X+8,Y+3,0
  1570.    Extension_8_1016 X+9,Y+2 To X+13,Y+6,0
  1571.    Extension_8_1016 X+9,Y+3 To X+12,Y+6,0
  1572. End Proc
  1573. Procedure DEFARROWD[BT,X,Y]
  1574.   DRAARROWD[X,Y]
  1575.   DEFGAD[BT,X,Y,X+17,Y+8,3]
  1576. End Proc
  1577. Procedure DRAARROWD[X,Y]
  1578.   DRABOX[X,Y,X+17,Y+8,0]
  1579.    Extension_8_1016 X+4,Y+2 To X+8,Y+6,0
  1580.    Extension_8_1016 X+5,Y+2 To X+8,Y+5,0
  1581.    Extension_8_1016 X+9,Y+6 To X+13,Y+2,0
  1582.    Extension_8_1016 X+9,Y+5 To X+12,Y+2,0
  1583. End Proc
  1584. Procedure DRAPROCBAR[BT,POS,MX]
  1585.   X1=FB(BT,0)+2 : X2=FB(BT,2)-2 : Y1=FB(BT,1)+1 : Y2=FB(BT,3)-1
  1586.   DX=X2-X1
  1587.   PX=X1+(POS*DX)/MX
  1588.   If PX>X1 and PX<X2
  1589.     Ink 0 : Bar X1,Y1 To PX,Y2
  1590.     Ink 2 : Bar PX,Y1 To X2,Y2
  1591.   End If 
  1592.   If PX=X1 Then Ink 2 : Bar X1,Y1 To X2,Y2
  1593.   If PX=X2 Then Ink 0 : Bar X1,Y1 To X2,Y2
  1594. End Proc
  1595. Procedure DRASLIDER[BT,LINOFF,PAG,NUMLIN,NB]
  1596.   D=(FB(BT,3)-FB(BT,1))-4
  1597.   Y1=(LINOFF*D)/Max(NUMLIN,PAG)+FB(BT,1)+2
  1598.   Y2=((LINOFF+PAG)*D)/Max(NUMLIN,PAG)+FB(BT,1)+2
  1599.   DEFGAD[NB,FB(BT,0)+4,Y1,FB(BT,2)-4,Y2,3]
  1600.   Ink 2
  1601.   If Y1>FB(BT,1)+2 Then Bar FB(BT,0)+4,FB(BT,1)+1 To FB(BT,2)-4,Y1-1
  1602.   If Y2<FB(BT,3)-2 Then Bar FB(BT,0)+4,Y2+1 To FB(BT,2)-4,FB(BT,3)-1
  1603.   If Y2-Y1>0
  1604.     Ink 0 : Bar FB(BT,0)+4,Y1 To FB(BT,2)-4,Y2
  1605.   Else 
  1606.      Extension_8_1016 FB(BT,0)+4,Y1 To FB(BT,2)-4,Y2,0
  1607.   End If 
  1608. End Proc
  1609. Procedure DRAGSLIDER[BT,Y,PAG,NUMLIN,NB]
  1610.   Y1=FB(NB,1) : Y2=FB(NB,3) : D=Y2-Y1
  1611.   Y1=Min(Max(FB(BT,1)+2,Y),FB(BT,3)-2-D)
  1612.   Y2=Y1+D : FB(NB,1)=Y1 : FB(NB,3)=Y2
  1613.   Ink 2
  1614.   If Y1>FB(BT,1)+2 Then Bar FB(BT,0)+4,FB(BT,1)+1 To FB(BT,2)-4,Y1-1
  1615.   If Y2<FB(BT,3)-2 Then Bar FB(BT,0)+4,Y2+1 To FB(BT,2)-4,FB(BT,3)-1
  1616.   If Y2-Y1>0
  1617.     Ink 1 : Bar FB(BT,0)+4,Y1 To FB(BT,2)-4,Y2
  1618.   Else 
  1619.      Extension_8_1016 FB(BT,0)+4,Y1 To FB(BT,2)-4,Y2,1
  1620.   End If 
  1621.   D=FB(BT,3)-FB(BT,1)-4
  1622.   L=Min(((Y1-FB(BT,1)-2)*Max(NUMLIN,PAG)+D/2)/D,NUMLIN-PAG)
  1623. End Proc[L]